home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tptsr.zip / TSR.DEM < prev    next >
Text File  |  1990-06-25  |  4KB  |  124 lines
  1. program demo;  { See tsr.doc and tsr.skl for details. }
  2.  
  3. uses crt, dos, tsr, crtplus, calendar;
  4.  
  5. {$M 4096,4096,4096}
  6.  
  7.  
  8. {$F+}
  9. procedure Startup;
  10.     begin
  11.         clrscr;
  12.         writeln('Shareware TSR unit demo');
  13.         writeln('Copyright John W. Small 1990');
  14.         writeln('PSW, P.O. Box 10072, McLean VA 22102 8072');
  15.         writeln;
  16.         writeln('Press <Alt> C to popup calendar; ESC to exit.');
  17.         writeln('Cursor keys change months; page keys change years.');
  18.         writeln;
  19.         writeln('At the command line prompt type: ');
  20.         writeln;
  21.         writeln('   tsr -r       to remove the TSR from memory,');
  22.         writeln('   tsr -d       to deactivate the TSR in memory,');
  23.         writeln('   tsr -a       to activate TSR in memory,');
  24.         writeln('   tsr -m       to force monochrome display,');
  25.         writeln('   tsr -c       to force color display,');
  26.         writeln('   tsr -p       to popup calendar.');
  27.         writeln;
  28.         writeln('This shareware TSR demo can be popped up only 3');
  29.         writeln('times without registering.  Type "tsr -r" at the');
  30.         writeln('command line prompt for registration information.');
  31.  
  32.     end;
  33. procedure Popup;
  34.     var ftw : FramedTextWindow;
  35.         y, m, d, dow : word;
  36.     begin
  37.         if not CrtPlus.TxtScr.IsTextMode then
  38.            exit;
  39.         ftw.window(5,5,28,14);
  40.         if TSRcolor then begin
  41.             TextColor(BLACK);
  42.             TextBackground(CYAN)
  43.             end
  44.         else begin
  45.             TextColor(BLACK);
  46.             TextBackground(LIGHTGRAY)
  47.             end;
  48.         ftw.frame(TextAttr,svsh);
  49.         cursor.off;
  50.         clrscr;
  51.         GetDate(y,m,d,dow);
  52.         WriteCalendar(y,m);
  53.         while crtplus.readkey <> ESC do begin
  54.             case char(lo(crtplus.asciiScan)) of
  55.                 #0: case char(hi(crtplus.asciiScan)) of
  56.                         LArr, UpArr: begin
  57.                             if m > 1 then
  58.                                 dec(m)
  59.                             else begin
  60.                                 m := 12;
  61.                                 dec(y)
  62.                                 end;
  63.                             if y <= 1752 then begin
  64.                                 y := 1752;
  65.                                 m := 10
  66.                                 end
  67.                             end;
  68.                         RArr, DnArr:
  69.                             if m < 12 then
  70.                                  inc(m)
  71.                             else begin
  72.                                 m := 1;
  73.                                 inc(y)
  74.                                 end;
  75.                         PgUp: begin
  76.                             dec(y);
  77.                             if y <= 1752 then begin
  78.                                 y := 1752;
  79.                                 m := 10
  80.                                 end
  81.                             end;
  82.                         PgDn: inc(y);
  83.                         Home: GetDate(y,m,d,dow);
  84.                     end;
  85.                 end;
  86.             clrscr;
  87.             WriteCalendar(y,m)
  88.             end;
  89.         ftw.done
  90.     end;
  91. procedure Wrapup;
  92.     begin
  93.         clrscr;
  94.         writeln('To register the TSR unit sent $20 to:');
  95.         writeln;
  96.         writeln('    PSW / Power SoftWare');
  97.         writeln('    P.O. Box 10072');
  98.         writeln('    McLean, VA 22102 8072');
  99.         writeln;
  100.         writeln('Upon registration you will be sent the source code');
  101.         writeln('for tsr.pas and cmdln.pas on a 5.25" DOS diskette.');
  102.         writeln;
  103.         writeln('Check your favorite BBS for other shareware tools for TP 5.5 from PSW:');
  104.         writeln;
  105.         writeln('    crtplus      $20  keyboard, cursor, and popup window');
  106.         writeln('                      enhancements to crt unit, 100+ page manual');
  107.         writeln('    omouse        $7  mouse object, primitive paint demo');
  108.         writeln('    graphtxt      $7  text file device driver for graphic');
  109.         writeln('                      modes, any font, any justification.');
  110.         writeln('    tpflex       $20  flexlist object, 100+ page manual');
  111.         writeln('                      generic stack-queue-list-array');
  112.         writeln('    tppan         $7  panscroller object, generic pan-scroll');
  113.         writeln('                      for editors, pick lists, spreadsheets, etc.');
  114.  
  115.     end;
  116. procedure OptionComm(optCh: char; argSeg, argOfs : word);
  117.     begin
  118.     end;
  119. {$F-}
  120.  
  121.  
  122. begin
  123.     MakeTSR('','TSR Demo',46,8,Startup,Popup,Wrapup,OptionComm);
  124. end.